home *** CD-ROM | disk | FTP | other *** search
/ LOGIC Apps / Logic-APPLE_II_APPS.iso / mac / LOGIC Apple II 5.25" Library - ProDOS / PRO004.dsk / FILECABINET.bas < prev    next >
BASIC Source File  |  2012-02-16  |  33KB  |  750 lines
  1. 10  REM    FILE CABINET -  PRODOS  
  2. 20  REM   PRINTER SETUP FOR EPSON
  3. 40  REM   JUNE 1984 UPDATE
  4. 50  REM   MICHAEL MOORE    
  5. 60 :
  6. 70  REM  APPLE CORPS OF DALLAS
  7. 80 :
  8. 310 DB$ = "":FD$ = "": ONERR  GOTO 13010
  9. 500  REM  << INTRO TITLE >> 
  10. 510  TEXT : HOME : VTAB 5
  11. 520  HTAB 13: INVERSE : PRINT "FILE CABINET": PRINT 
  12. 530  HTAB 12: PRINT "PRODOS VERSION": PRINT 
  13. 540  HTAB 11: PRINT "BY MICHAEL MOORE": PRINT 
  14. 550  HTAB 14: PRINT "JUNE 1984": NORMAL 
  15. 560  FOR Z = 1 TO 1500: NEXT Z
  16. 600  REM  << PRODOS DATE SET >>
  17. 610 DD =  PEEK(49040) - INT( PEEK(49040)/32) *32
  18. 620  IF DD < >0 GOTO 1000: REM  SKIP DATE IF NOT NEEDED
  19. 630  VTAB 13: CALL  -958: REM  CLEAR TO BOTTOM
  20. 640  PRINT "  DATE INPUT ROUTINE": PRINT 
  21. 645  VTAB 15: CALL  -868
  22. 650  INPUT "ENTER NUMBER OF CURRENT MONTH      :";MM
  23. 655  IF MM <0  OR MM >12 GOTO 645
  24. 657  VTAB 16: CALL  -868
  25. 660  INPUT "ENTER NUMBER OF CURRENT DAY        :";DD
  26. 665  IF DD <0  OR DD >31 GOTO 657
  27. 667  VTAB 17: CALL  -868
  28. 670  INPUT "ENTER LAST TWO DIGITS OF THE YEAR  :";YY
  29. 675  IF YY <0  OR YY >99 GOTO 667
  30. 680  POKE 49041,YY *2 +(MM >7)
  31. 690  IF MM >7  THEN  POKE 49040,(MM -8) *32 +DD
  32. 700  IF MM <8  THEN  POKE 49040,MM *32 +DD
  33. 710  PRINT : GOSUB 60110
  34. 720  PRINT "THE DATE ENTERED IS "
  35. 730  HTAB 25: PRINT TD$: PRINT 
  36. 740 L$ = "IS THIS CORRECT? ": GOSUB 2510
  37. 750  IF   NOT YES GOTO 630
  38. 1000  POKE 216,0: GOTO 3010
  39. 2000  REM  <<< PRINTER SETUP >>>
  40. 2010  PRINT D$"PR#1": PRINT  CHR$(18);: PRINT  CHR$(27) + CHR$(70);
  41. 2020  ON PF GOTO 2030,2050
  42. 2030  PRINT  CHR$(9)"80N";: PRINT  CHR$(27) + CHR$(69): RETURN 
  43. 2050  PRINT  CHR$(9)"132N";: PRINT  CHR$(15);: RETURN 
  44. 2100  PRINT :L$ = "PRINT SET-UP CORRECT ": GOSUB 2510: IF YES = 1  THEN  GOTO 2110
  45. 2105  IF YES = 0  THEN  POP : GOTO 28010
  46. 2110  PRINT : INVERSE : PRINT  TAB( 10)"TURN YOUR PRINTER ON" SPC( 10)" ": NORMAL : PRINT 
  47. 2120  INPUT "PRESS <RETURN> WHEN READY...";R$: RETURN 
  48. 2410  PRINT L$"->":V =  PEEK(37)::H =  LEN(L$) +3
  49. 2420  VTAB V: HTAB H: CALL  -868: INPUT "";R$:R =  VAL(R$): CALL  -958
  50. 2430  IF R <1  OR R >CHOICE  THEN 2450
  51. 2440  PRINT : RETURN 
  52. 2450  IF V = 23  THEN V = 22
  53. 2460  CALL  -868: PRINT "ENTER NUMBER 1 THRU ";CHOICE: GOTO 2420
  54. 2480  IF SEP = 1  THEN  RETURN 
  55. 2482  HOME : PRINT : PRINT "SPACING FOR PRINTED FORMAT": PRINT 
  56. 2483  PRINT  TAB( 3)"<1> SKIP BLANK LINE BETWEEN RECORDS"
  57. 2484  PRINT  TAB( 3)"<2> RECORDS PRINTED THEN BLANK LINE"
  58. 2485  PRINT  TAB( 3)"<3> RECORDS PRINTED THEN BLANK LINE"
  59. 2486  PRINT  TAB( 3)"<4> RECORDS PRINTED THEN BLANK LINE"
  60. 2487  PRINT  TAB( 3)"<5> RECORDS PRINTED THEN BLANK LINE"
  61. 2489  PRINT : PRINT  TAB( 7)"WHICH ->:";: CALL  -868: INPUT "";LC
  62. 2490  IF LC <1  OR LC >5  THEN  PRINT  CHR$(7) + CHR$(7): GOTO 2480
  63. 2493  IF LC = 1  THEN LT = 30
  64. 2494  IF LC = 2  THEN LT = 40
  65. 2495  IF LC = 3  THEN LT = 45
  66. 2496  IF LC = 4  THEN LT = 48
  67. 2497  IF LC = 5  THEN LT = 50
  68. 2499  RETURN 
  69. 2510 V =  PEEK(37) +1
  70. 2515  PRINT L$" (Y/N)"
  71. 2520  IF V >23  THEN V = 23
  72. 2530  VTAB V: HTAB ( LEN(L$) +8): CALL  -868: INPUT A$: IF A$ = "Y"  THEN YES = 1: RETURN 
  73. 2540  IF A$ = "N"  THEN YES = 0: RETURN 
  74. 2550  INVERSE : PRINT "PRESS 'Y' OR 'N'...": NORMAL : IF V =  >23  THEN V = 22
  75. 2560  GOTO 2530
  76. 3010  REM  << STARTUP >>>
  77. 3030  TEXT : HOME 
  78. 3040  GOSUB 32010
  79. 3045  GOSUB 34000
  80. 3050  IF MS = 1  AND NR = 0 GOTO 38010: REM   CHECK FOR ZERO RECORDS IN NEW FILE 
  81. 3055  CLEAR 
  82. 3060  DIM R$(65),AC(21),K(66),H$(21),RN$(21)
  83. 3070  DIM L%(21)
  84. 3071 D$ =  CHR$(4)
  85. 3072  PRINT D$;"PREFIX"
  86. 3073  INPUT PX$: REM  OBTAIN PATH OF CURRENT DISK
  87. 3075  GOSUB 60110: REM  SETUP DATE AFTER CLEAR
  88. 3090 H$(0) = "REC#"
  89. 3100 DB$ = "":FD$ = "": ONERR  GOTO 13010
  90. 3105  PRINT D$;"VERIFY"PX$ +"BASENAMES"
  91. 3110  GOSUB 23010
  92. 3120  GOTO 13010
  93. 4000  REM  << GET FILE >>
  94. 4010 F$ = "HEADER": ONERR  GOTO 6010
  95. 4015  PRINT D$"VERIFY"PX$ +FD$ +"/" +F$
  96. 4020  GOSUB 23010
  97. 4100  FOR I = 1 TO NR:H$(I) = R$(I):L%(I) =  LEN(R$(I)): NEXT I
  98. 4110 NH = NR:NR = 0:MEM =  FRE(0)
  99. 4120 B =  INT((MEM -16)/(18 *NH +8))
  100. 4130  DIM N$(B,NH),R(B),S(B)
  101. 4140 F$ = "INDEX": ONERR  GOTO 28100
  102. 4150  GOSUB 23010
  103. 4160  GOTO 28010
  104. 5000  REM  <<< SORT ROUTINE >>
  105. 5010 N = NR:M = N:FF = 0: ONERR  GOTO 5080
  106. 5020 M =  INT(M/2):K = N -M:J = 1: PRINT "SORTING ";: IF M = 0  THEN  PRINT  CHR$(13): GOTO 5100
  107. 5030 I = J
  108. 5040 LL = I +M:I2 = R(I):L2 = R(LL): ON L GOTO 5050,5060: ON ( VAL(N$(I2,S)) =  > VAL(N$(L2,S))) GOTO 5080: GOTO 5070
  109. 5050  ON (N$(I2,S) < = N$(L2,S)) GOTO 5080: GOTO 5070
  110. 5060  ON ( VAL(N$(I2,S)) < =  VAL(N$(L2,S))) GOTO 5080
  111. 5070 Y = R(I):R(I) = R(LL):R(LL) = Y:I = I -M: IF I > = 1  THEN 5040
  112. 5080 J = J +1: IF J >K  THEN 5020
  113. 5090  GOTO 5030
  114. 5100  POKE 216,0: HTAB 10: INVERSE : FLASH : PRINT " <SORTING COMPLETE> ": NORMAL 
  115. 5200  PRINT : PRINT "WANT TO SAVE >"FD$"< FILE":L$ = "SORTED BY >" +H$(S) +"< TO DISK ": GOSUB 2510: IF YES  THEN F$ = "INDEX": GOSUB 24010
  116. 5210  GOTO 28010
  117. 5400 MF = 1: GOSUB 21010
  118. 5410 L$ = "ENTER # OF FIELD FOR SORT ":CHOICE = NH: GOSUB 2410:S = R
  119. 5411 ST = 0
  120. 5412  IF NR =  <40  THEN ST = 2
  121. 5413  IF NR >40  THEN ST = 6
  122. 5414  IF NR >90  THEN ST = 15
  123. 5415  IF NR >140  THEN ST = 70
  124. 5416  IF NR >200  THEN ST = 150
  125. 5417  IF NR >250  THEN ST = 250
  126. 5418  IF NR >300  THEN ST = 370
  127. 5419  PRINT : PRINT "SORT WILL TAKE APPROX. ";: FLASH : PRINT (ST + INT(.06 *NR * LOG(NR)));: NORMAL : PRINT " SECONDS": PRINT 
  128. 5420  PRINT : PRINT "DO YOU WANT TO SORT:": PRINT 
  129. 5430  PRINT "1 ALPHABETICALLY"
  130. 5440  PRINT "2 NUMERICALLY (LOW TO HIGH)"
  131. 5450  PRINT "3 NUMERICALLY (HIGH TO LOW)": PRINT 
  132. 5460 L$ = "WHICH ":CHOICE = 3: GOSUB 2410:L = R
  133. 5470  PRINT : PRINT : GOTO 5010
  134. 6000  REM  << ENTER HEADERS >>
  135. 6010  CALL 1013
  136. 6020  POKE 216,0
  137. 6030 NR = 1
  138. 6032  HOME 
  139. 6035  PRINT "HEADERS FOR <"DB$"> DATA BASE": PRINT 
  140. 6036  PRINT  TAB( 10)"MAXIMUM 20 HEADERS"
  141. 6037  PRINT " HEADER NAMES MAXIMUM 15 CHARACTERS"
  142. 6040  PRINT : PRINT "AFTER LAST HEADER, PRESS <RETURN> TO    EXIT TO MAIN MENU"
  143. 6050  PRINT 
  144. 6060  PRINT "HEADER NAME FOR COLUMN #"NR": ";: CALL 768,R$(NR)
  145. 6065  IF R$(1) = "" GOTO 6010
  146. 6070  IF R$(NR) = ""  OR NR >20  THEN 6110
  147. 6080 L%(NR) =  LEN(R$(NR))
  148. 6090 NR = NR +1
  149. 6100  GOTO 6060
  150. 6110 NR = NR -1
  151. 6120  IF NR <1  THEN 14100
  152. 6130  GOSUB 24010: GOTO 4100
  153. 7000  REM  << DATA ENTRY >>>
  154. 7010  HOME 
  155. 7020  PRINT "THERE ARE NOW "NR" RECORDS"
  156. 7030  PRINT "IN THE >"DB$"< DATA FILE"
  157. 7040  HOME :NR = NR +1:R(NR) = NR
  158. 7050  PRINT "YOU ARE ENTERING RECORD # "NR
  159. 7060  PRINT "HIT '/' TO USE LAST RECORD'S ANSWER"
  160. 7070  PRINT 
  161. 7080  FOR I = 1 TO NH
  162. 7090  PRINT H$(I)":";: CALL 768,N$(NR,I)
  163. 7100  IF N$(NR,I) =  CHR$(47)  THEN N$(NR,I) = N$(NR -1,I): PRINT N$(NR,I)
  164. 7110 L =  LEN(N$(NR,I)): IF L >L%(I)  THEN L%(I) = L
  165. 7120  NEXT I
  166. 7130  PRINT 
  167. 7140 L$ = "MORE ": GOSUB 2510: IF YES  THEN  GOTO 7040
  168. 7150 F$ = "INDEX"
  169. 7160  GOSUB 24010
  170. 7170  GOTO 28010
  171. 8000  REM  << SEARCH ROUTINE >>>
  172. 8010 L = 0
  173. 8020  GOSUB 21010
  174. 8070  PRINT I" MAKE CHANGES": PRINT I +1" RETURN TO THE MENU."
  175. 8080 V =  PEEK(37) +2
  176. 8090  VTAB V: CALL  -868: INPUT "WHICH ->";S$:S =  VAL(S$)
  177. 8100 X = 0: FOR I = 1 TO NH: IF  LEN(H$(I)) >X  THEN X =  LEN(H$(I))
  178. 8110  NEXT I:X = X +1
  179. 8120  IF S <0  OR S >NH +2  THEN 8090
  180. 8125  ON (S < = NH) GOTO 8140: ON S -NH GOTO 10010,28010
  181. 8140  HOME 
  182. 8150  PRINT "PLEASE ENTER THE "H$(S): PRINT "YOU WANT TO FIND....";: CALL 768,Q$
  183. 8160  HOME : VTAB 3: INVERSE : FLASH : PRINT "PATIENCE";: NORMAL : PRINT " - HAVE "NR" RECORDS TO CHECK...": PRINT 
  184. 8162  FOR W = 1 TO 500: NEXT W: HOME 
  185. 8165  IF PF  THEN  GOSUB 2100: HOME 
  186. 8170  IF PF  THEN  GOSUB 2010
  187. 8180  FOR J = 1 TO NR:Y = R(J)
  188. 8190 N$(Y,0) =  STR$(Y)
  189. 8200  IF  LEN(Q$) >0  THEN 8230
  190. 8210  IF  LEN(N$(Y,S)) = 0  THEN  GOSUB 11010
  191. 8220  GOTO 8240
  192. 8230  IF  LEFT$(N$(Y,S), LEN(Q$)) = Q$  THEN  GOSUB 11010
  193. 8240  IF   NOT PF  AND L +NH >20  THEN  GOSUB 9010
  194. 8250  IF LF  THEN J = NR
  195. 8260  NEXT J
  196. 8270 L = 0: PRINT D$"PR#0"
  197. 8280  IF LF  THEN LF = 0: HOME : GOTO 8300
  198. 8290  PRINT "THAT'S ALL OF THEM. ";
  199. 8300  PRINT "NOW YOU MAY:"
  200. 8310  PRINT "1 DO MORE SEARCHES"
  201. 8320  PRINT "2 MAKE CHANGES"
  202. 8330  PRINT "3 RETURN TO THE MAIN MENU"
  203. 8340  PRINT :L$ = "WHICH ":CHOICE = 3: GOSUB 2410:S = R
  204. 8350  ON S GOTO 8020,10010,28010
  205. 9010  IF (PF)  OR (AR)  THEN 9030
  206. 9020  PRINT "PRESS RETURN TO CONTINUE, ESC TO ABORT";: GOTO 9050
  207. 9030 LF =  PEEK( -16384): POKE  -16368,0
  208. 9040  ON LF = 141 GOTO 9050: ON LF = 155 GOTO 9070: GOTO 9090
  209. 9050 LF =  PEEK( -16384): IF LF <128  THEN 9050
  210. 9060  POKE  -16368,0
  211. 9070  IF LF = 155  THEN LF = 1: GOTO 9100
  212. 9080  IF LF < >141  THEN 9050
  213. 9090 LF = 0
  214. 9100  IF PF = 0  AND AR = 0  THEN  PRINT :L = 0: HOME 
  215. 9110  RETURN 
  216. 10010  HOME : VTAB 5: PRINT "ENTER THE NUMBER OF THE RECORD TO"
  217. 10020 L$ = "CHANGE ":CHOICE = NR: GOSUB 2410:J = R:Y = R(J)
  218. 10030  HOME : GOSUB 11010
  219. 10040  PRINT : PRINT "ENTER THE NUMBER OF THE FIELD YOU WANT"
  220. 10050 L$ = "TO CHANGE ":CHOICE = NH: GOSUB 2410:S = R
  221. 10060  PRINT 
  222. 10070  PRINT "FROM "H$(S)": "N$(Y,S)
  223. 10080  PRINT 
  224. 10090  PRINT  TAB( 3)"TO "H$(S)" :";: CALL 768,N$(Y,S)
  225. 10100  HOME : GOSUB 11010
  226. 10110  PRINT 
  227. 10120 L$ = "MORE CHANGES ": GOSUB 2510: IF YES  THEN  GOTO 10010
  228. 10130 F$ = "INDEX": GOSUB 24010: GOTO 28010
  229. 11010 LT = 60: IF PF  AND L = 0  THEN  PRINT  TAB( 8)DB$" DATA BASE";: POKE 36, LEN(DB$) +20: PRINT TD$: PRINT :L = L +2
  230. 11015  PRINT  TAB( 4 +5 *(PF >1))H$(0);J
  231. 11020  FOR I = 1 TO NH
  232. 11030  POKE 36,5 *(PF >0) +1: PRINT I" "H$(I)":";: POKE 36,X +5 *(PF >0) +5: PRINT N$(Y,I)
  233. 11040  NEXT I
  234. 11050  PRINT 
  235. 11060 L = L +NH +2
  236. 11070  IF PF  AND (L +NH) >(LT -1)  THEN  PRINT  CHR$(12):L = 0
  237. 11080  RETURN 
  238. 12000  REM  << DELETE RECORDS >>
  239. 12010  HOME : PRINT "ENTER 0 TO RETURN TO THE MENU!":I = 0
  240. 12020  VTAB 7: CALL  -958: INPUT "ENTER RECORD NUMBER TO DELETE -> ";S$:S =  VAL(S$): IF I = 0  AND S$ = "0"  THEN 28010
  241. 12025  IF S$ = "END"  THEN 12065
  242. 12030  IF S <1  OR S >NR  THEN 12020
  243. 12040 R(S) = 0:I = I +1: IF I = NR  THEN 14100
  244. 12050  PRINT : PRINT "RECORD NUMBER "S" DELETED!": PRINT 
  245. 12060 L$ = "MORE ": GOSUB 2510: IF YES  THEN  HOME : PRINT "TYPE 'END' TO TERMINATE DELETIONS!": GOTO 12020
  246. 12065 I = 1:J = 0
  247. 12070  IF R(I) = 0  THEN 12090
  248. 12080 J = J +1:R(J) = R(I)
  249. 12090 I = I +1: ON I >NR GOTO 12095: GOTO 12070
  250. 12095  HOME : VTAB 7: HTAB 13: FLASH : PRINT "<HOUSEKEEPING>": NORMAL : PRINT 
  251. 12097  PRINT : PRINT : PRINT NR" RECORDS BEING RE-NUMBERED...."
  252. 12100  ON J = 0 GOTO 14100: VTAB 15: PRINT "ONE MINUTE PLEASE...":NR = J:F$ = "INDEX": GOSUB 24010: GOSUB 23010: GOTO 28010
  253. 13000  REM  << INITIAL MENU >>
  254. 13010  HOME 
  255. 13011  VTAB 5: HTAB 10: PRINT "FILE CABINET -PRODOS": PRINT 
  256. 13012  PRINT  TAB( 6)"UPDATED BY MICHAEL MOORE": PRINT 
  257. 13013  PRINT "INFORMATION STORAGE AND RETRIEVAL SYSTEM"
  258. 13015  PRINT : HTAB 3
  259. 13020  PRINT "SELECT FROM:": PRINT 
  260. 13030  IF   NOT NR  THEN J = 1: GOTO 13050
  261. 13040  FOR J = 1 TO NR: PRINT J" "R$(J): NEXT J: PRINT 
  262. 13050  PRINT J" QUIT"
  263. 13060  PRINT J +1" CREATE A NEW DATA BASE"
  264. 13070  IF J >1  THEN  PRINT J +2" DELETE A DATA BASE"
  265. 13080  PRINT : HTAB 3
  266. 13090  INPUT "WHICH -> ";S$:S =  VAL(S$)
  267. 13100  IF S <J  THEN 13120
  268. 13110  ON S -NR GOTO 31005,13150,14010
  269. 13120  IF S <1  OR S >NR  THEN  PRINT  CHR$(7);: VTAB  PEEK(37): CALL  -868: GOTO 13090
  270. 13125  VTAB 22: CALL  -868: HTAB 6: FLASH : PRINT "LOADING";: NORMAL : PRINT " - ONE MOMENT PLEASE"
  271. 13130 FD$ = R$(S)
  272. 13140  GOTO 4010
  273. 13150  PRINT 
  274. 13510  VTAB 20: CALL  -958
  275. 13520  IF J = 0  THEN J = 1
  276. 13525  PRINT : PRINT : PRINT "MAXIMUM 10 CHARACTERS, PLEASE!": PRINT 
  277. 13527  PRINT  SPC( 5);"NAME MUST START WITH A LETTER": PRINT 
  278. 13530  INPUT "NAME FOR NEW DATA BASE FILE :";R$(J)
  279. 13540  IF   NOT  LEN(R$(J))  THEN 13010
  280. 13542  IF  ASC(R$(J)) <65 GOTO 13510
  281. 13543  FOR T = 1 TO  LEN(R$(J))
  282. 13544  IF  ASC( MID$ (R$(J),T,T)) >64  AND  ASC( MID$ (R$(J),T,T)) <91 GOTO 13551
  283. 13545  IF  ASC( MID$ (R$(J),T,T)) >47  AND  ASC( MID$ (R$(J),T,T)) <58 GOTO 13551
  284. 13546  IF  ASC( MID$ (R$(J),T,T)) = 46 GOTO 13551
  285. 13547  VTAB 20 - CALL  -958: PRINT "FILE NAME MUST CONFORM TO PRODOS RULES"
  286. 13548  PRINT " ONLY LETTERS, NUMERAL AND PERIODS       ARE ALLOWED"
  287. 13549 T =  LEN(R$(J)):R$(J) = ""
  288. 13550  PRINT "  PRESS ANY KEY TO CONTINUE ";: GET K$
  289. 13551  NEXT T
  290. 13552  IF R$(J) = "" GOTO 13010
  291. 13554 FD$ = R$(J)
  292. 13556  PRINT D$"CREATE";PX$ +FD$
  293. 13558 NR = J: GOSUB 24010
  294. 13560 DB$ = R$(J -1): GOTO 4010
  295. 14000  REM  << FILES ROUTINE >>
  296. 14010  PRINT : INPUT "DELETE WHICH -> ";S$:S =  VAL(S$)
  297. 14020  IF S <1  OR S >J -1  THEN  PRINT  CHR$(7);: VTAB  PEEK(37) -1: CALL  -868: GOTO 14010
  298. 14030  HOME : VTAB (9): PRINT "READY TO DELETE ";: INVERSE : PRINT R$(S);: NORMAL : PRINT ".": PRINT 
  299. 14040  PRINT "ONCE DELETED, THIS DATA CANNOT BE"
  300. 14050  PRINT "RECOVERED.  ARE YOU SURE THAT YOU"
  301. 14060  PRINT "WANT TO DELETE IT? (Y/N) ";: INPUT "";S$
  302. 14070  IF S$ < >"Y"  THEN 13010
  303. 14080  HOME : VTAB 12: INVERSE : PRINT "[ DELETING "R$(S)" DATABASE ]": NORMAL 
  304. 14090 FD$ = R$(S)
  305. 14100  ONERR  GOTO 14170
  306. 14110 F$ = "RPTFMTNAME"
  307. 14115  PRINT D$"VERIFY";PX$ +FD$ +"/" +F$
  308. 14120  GOSUB 23010
  309. 14125  VTAB 15: CALL  -868: PRINT "DELETING ";PX$ +FD$ +"/" +F$
  310. 14130  PRINT D$"DELETE";PX$ +FD$ +"/" +F$
  311. 14140  FOR I = 1 TO NR
  312. 14145  VTAB 15: CALL  -868: PRINT "DELETING ";PX$ +FD$ +"/" +"RPTFMT" +R$(I)
  313. 14150  PRINT D$"DELETE";PX$ +FD$ +"/" +RPTFMT"+R$(I)
  314. 14160  NEXT I
  315. 14170  POKE 216,0: CALL 1013
  316. 14175  VTAB 15: CALL  -868: PRINT "DELETING";PX$ +FD$ +"/" +"INDEX"
  317. 14180  PRINT D$"DELETE";PX$ +FD$ +"/" +"INDEX"
  318. 14185  VTAB 15: CALL  -868: PRINT "DELETING ";PX$ +FD$ +"/" +"HEADER"
  319. 14190  PRINT D$"DELETE";PX$ +FD$ +"/" +"HEADER"
  320. 14200 R$(0) = FD$
  321. 14210 F$ = "": GOSUB 23010
  322. 14212  IF NR -1 =  >1 GOTO 14221
  323. 14215  VTAB 15: CALL  -868: PRINT "DELETING ";PX$ +"BASENAMES"
  324. 14220  PRINT D$"DELETE";PX$ +"BASENAMES"
  325. 14221  VTAB 15: CALL  -868: PRINT "DELETING ";PX$ +FD$
  326. 14222  PRINT D$"DELETE";PX$ +FD$
  327. 14225  IF NR -1 <1 GOTO 3050
  328. 14229  VTAB 15: CALL  -868: PRINT "SAVING REMAINING FILE NAMES"
  329. 14230 I = 0:J = 1
  330. 14240  IF R$(J) = R$(0)  THEN 14255
  331. 14250 I = I +1:R$(I) = R$(J)
  332. 14255 J = J +1: ON J >NR GOTO 14260: GOTO 14240
  333. 14260 NR = I: GOSUB 24010
  334. 14270  GOTO 13010
  335. 15000  REM  << REPORT ROUTINE >> 
  336. 15010  HOME :E = 0:WIDE = 0:L%(0) = 4:HR = 0
  337. 15020  FOR I = 0 TO (NH +1) *3:K(I) = 0: NEXT I:L%(NH +1) = 0:PAGE = 0:TF = 0
  338. 15030  FOR I = 1 TO NH:AC(I) = 0: NEXT I:HC = 0:GT = 0: ON E GOTO 15500: GOTO 22010
  339. 15100  POKE 34, PEEK(37) +2: HOME : IF E = 0  THEN  INPUT "ENTER REPORT FORMAT NAME: ";RN$(NN)
  340. 15120  FOR I = 1 TO NH +1:K(I *3 -2) = 0:K(I *3 -1) = 0:K(I *3) = 0: VTAB I: HTAB 31: CALL  -868: NEXT I: CALL  -958:K(0) = 0: HOME 
  341. 15130 RH = 0: INPUT "ENTER TAB FOR LEFT MARGIN (=>1) ";K$:L =  VAL(K$): IF L <1  THEN L = 1
  342. 15140  FOR I = 1 TO (NH +1) *3  STEP 3
  343. 15150  HOME :V =  PEEK(37) +1: VTAB 23: INVERSE : PRINT "PRESS <RETURN> ALONE TO EXIT FORMAT...": NORMAL 
  344. 15155  VTAB V: PRINT "ENTER HEADER # FOR POSITION #"(I +2)/3" ";: INPUT "";K$: CALL  -958: IF   NOT  LEN(K$)  THEN I = (NH +1) *3: GOTO 15220
  345. 15160 K(I) =  VAL(K$): IF K(I) <0  OR K(I) >NH  THEN 15150
  346. 15180  PRINT :L$ = "TOTAL ON " +H$(K(I)): GOSUB 2510: CALL  -958: PRINT : IF YES  THEN K(I +2) = 1:K(0) = 1:TF = 1:L = L +2: GOTO 15190
  347. 15185 L$ = "RIGHT JUSTIFY DATA?": GOSUB 2510: IF YES  THEN K(I +2) = 2
  348. 15190 K(I +1) = L:L = L +L%(K(I)) +2:WIDE = L -2:RH = RH +1
  349. 15200  VTAB K(I) +1: HTAB 32: PRINT (I +2)/3 TAB( 36)K(I +1);: IF K(I +2) = 1  THEN  PRINT  TAB( 39)"T";
  350. 15202  IF K(I +2) = 2  THEN  PRINT  TAB( 39)"F";
  351. 15205  PRINT : IF WIDE >131 -(10 *K(0))  THEN ER = 1:I = (NH +1) *3
  352. 15220  NEXT I:I = RH *3 +1: IF   NOT ER  THEN 15250
  353. 15230 ER = 0: HOME : PRINT "THIS REPORT IS TOO WIDE!":L$ = "TRY AGAIN?": GOSUB 2510: ON YES GOTO 15120: TEXT : GOTO 28010
  354. 15250 V = NH +2: ON K(0) = 0 GOTO 15300: HOME :L$ = "GRAND TOTAL?": GOSUB 2510:V = NH +2: IF   NOT YES  THEN K(0) = 0: GOTO 15300
  355. 15252  FOR J = 1 TO (NH +1) *3  STEP 3: ON K(J +2) = 1 GOTO 15254: GOTO 15264
  356. 15254  HOME : PRINT "ADD OR SUBTRACT ";: INVERSE : PRINT H$(K(J)): NORMAL : PRINT "TO/FROM GRAND TOTAL (A/S) ";: INPUT A$
  357. 15256  IF A$ = "A"  THEN K(J +2) = 1:A$ = "+T": GOTO 15262
  358. 15258  IF A$ = "S"  THEN K(J +2) =  -1:A$ = "-T": GOTO 15262
  359. 15260  GOTO 15254
  360. 15262  VTAB K(J) +1: HTAB 38: PRINT A$
  361. 15264  NEXT J
  362. 15270  FOR J = 1 TO RH: IF K(3 *J) = 1  OR K(3 *J) =  -1  THEN  IF L%(K(3 *J -2)) >L%(NH +1)  THEN L%(NH +1) = L%(K(3 *J -2)) +1
  363. 15275  NEXT J
  364. 15280 WIDE = L +L%(NH +1): IF WIDE >131  THEN 15230
  365. 15290 K(I) = NH +1:K(I +1) = L: VTAB V: PRINT "TOTAL" TAB( 32)RH +1 TAB( 36)K(I +1) +1:V = V +1
  366. 15300  VTAB V: PRINT "RIGHT MARGIN" TAB( 36)WIDE -1
  367. 15310  HOME :L$ = "IS THIS SATISFACTORY?": GOSUB 2510: ON YES GOTO 15500: GOTO 15120
  368. 15500  TEXT : IF TF  THEN TF = 0: PRINT : GOSUB 27010
  369. 15505  GOSUB 21010
  370. 15507  POKE 34, PEEK(37) +1: HOME 
  371. 15508 L$ = "FIRST COLUMN ONLY (IF ALPHA),           SEPERATE DIFFERENT LETTERS?": GOSUB 2510:SEP = 0: IF YES  THEN SEP = 1
  372. 15509  POKE 34, PEEK(37) -2: HOME 
  373. 15510 L$ = "SELECT ALL RECORDS?": GOSUB 2510: IF YES  THEN Q$ = "ALL": GOTO 15620
  374. 15520  HOME : INPUT "SELECT RECORDS BY WHICH HEADER #";S$:S =  VAL(S$): IF S <0  OR S >NH  THEN  PRINT  CHR$(7): GOTO 15520
  375. 15530  VTAB S +3: HTAB 20: INVERSE : PRINT "1ST": NORMAL 
  376. 15535  HOME :L$ = "'OR' 2ND HEADER?": GOSUB 2510: CALL  -958: IF   NOT YES  THEN 15560
  377. 15540  PRINT : INPUT "ENTER # OF 'OR' HEADER ->";K$:K =  VAL(K$): IF K <0  OR K >NH  THEN  PRINT  CHR$(7);: VTAB  PEEK(37) -1: CALL  -958: GOTO 15540
  378. 15550 HR = 1: GOTO 15575
  379. 15560  HOME :L$ = "'AND' 2ND HEADER?": GOSUB 2510: CALL  -958: IF   NOT YES  THEN K$ = "NO":HR = 1: GOTO 15590
  380. 15570  PRINT : INPUT "ENTER # OF 'AND' HEADER ->";K$:K =  VAL(K$):HR = 2: IF K <0  OR K >NH  THEN  PRINT  CHR$(7);: VTAB  PEEK(37) -1: CALL  -958:HR = 0: GOTO 15570
  381. 15575  IF K = S  THEN  VTAB S +3: HTAB 20: FLASH : PRINT "1ST": NORMAL :V = HR:HR = 0:K$ = "": ON V GOTO 15535,15560
  382. 15580  VTAB K +3: HTAB 20: INVERSE : IF HR = 1  THEN  PRINT "'OR' 2ND": GOTO 15590
  383. 15585  PRINT "'AND' 2ND"
  384. 15590  NORMAL : HOME : PRINT "ENTER RECORDS TO REPORT FOR "H$(S)"=";: INPUT Q$: PRINT : IF  LEN(Q$) = 0  THEN Q$ = "@"
  385. 15600  ON K$ = "NO" GOTO 15620: IF HR = 1  THEN  PRINT "OR ";: GOTO 15615
  386. 15610  PRINT "AND ";
  387. 15615  PRINT H$(K)"=";: CALL 768,K$: IF  LEN(K$) = 0  THEN K$ = "@"
  388. 15620  TEXT : HOME : IF WIDE  THEN 15630
  389. 15622  FOR J = 1 TO RH: IF K(3 *J) = 1  OR K(3 *J) =  -1  THEN  IF L%(K(3 *J -2)) >L%(NH +1)  THEN L%(NH +1) = L%(K(3 *J -2)) +1
  390. 15624  NEXT J
  391. 15626 WIDE = K(RH *3 -1) +L%(K(RH *3 -2)): IF K(RH *3 +2)  THEN WIDE = K(RH *3 +2) +L%(NH +1)
  392. 15630  IF PF  THEN PF = 1 +(WIDE >79): GOTO 15646
  393. 15635  IF WIDE <40  THEN 15660
  394. 15640  PRINT  CHR$(7)"THIS REPORT IS TOO WIDE FOR THE MONITOR": PRINT "SCREEN.  DO YOU WANT YOUR PRINTER":L$ = "ON? ": GOSUB 2510: IF   NOT YES  THEN  POKE 34,0: GOTO 15800
  395. 15641  IF   NOT  LEN(TD$)  THEN  GOSUB 2210
  396. 15645 T = S:S = 0: GOSUB 29020:S = T: GOTO 15630
  397. 15646  HOME : PRINT : PRINT "CONTINUOUS REPORT WITHOUT SPACING":L$ = "BETWEEN THE LINES?": GOSUB 2510:LC = 0:LT = 60: IF YES = 0  THEN  GOSUB 2480
  398. 15650  PRINT : INPUT "ENTER PAGE # OF FIRST PAGE -> ";R$:PAGE =  VAL(R$) -1: IF PAGE <0  THEN PAGE = 0
  399. 15655  GOSUB 2100
  400. 15660  IF PF = 0  THEN  GOSUB 2480
  401. 15661  TEXT : HOME : FOR I = 1 TO RH:AC(I) = 0
  402. 15662  IF K(3 *I) = 1  THEN T9 = 1
  403. 15665  NEXT I
  404. 15670  IF PF  THEN  GOSUB 2010
  405. 15675  GOSUB 18010
  406. 15679 LS = 1
  407. 15680  FOR J = 1 TO NR:Y = R(J)
  408. 15685 N$(Y,0) =  STR$(J)
  409. 15690  IF Q$ = "ALL"  THEN 15760
  410. 15695  ON HR GOTO 15705,15740
  411. 15705  IF Q$ = "@"  AND  LEN(N$(Y,S)) >0  THEN 15760
  412. 15710  IF  LEFT$(N$(Y,S), LEN(Q$)) = Q$  THEN 15760
  413. 15715  IF K$ = "NO"  THEN 15765
  414. 15720  IF K$ = "@"  AND  LEN(N$(Y,K)) >0  THEN 15760
  415. 15725  IF  LEFT$(N$(Y,K), LEN(K$)) < >K$  THEN 15765
  416. 15730  GOTO 15760
  417. 15740  IF Q$ = "@"  AND  LEN(N$(Y,S)) >0  THEN 15750
  418. 15745  IF  LEFT$(N$(Y,S), LEN(Q$)) < >Q$  THEN 15765
  419. 15750  IF K$ = "@"  AND  LEN(N$(Y,K)) >0  THEN 15760
  420. 15755  IF  LEFT$(N$(Y,K), LEN(K$)) < >K$  THEN 15765
  421. 15760  GOSUB 16010
  422. 15762  IF LS = LC  THEN  PRINT :LS = 0
  423. 15765  IF PF <1  THEN  IF LN >16  THEN  GOSUB 9010: IF   NOT LF  AND J <NR  THEN  GOSUB 18010:LS = 1: GOTO 15780
  424. 15770  IF LF  THEN J = NR: GOTO 15780
  425. 15775  IF J <NR  AND LN >LT  THEN  GOSUB 18010
  426. 15779 LS = LS +1
  427. 15780  NEXT J
  428. 15785  IF LF  THEN LF = 0: PRINT : GOTO 15795
  429. 15790  ON T9 GOSUB 17020
  430. 15795  PRINT : PRINT D$"PR#0"
  431. 15800  ON E GOTO 15815
  432. 15805  PRINT : PRINT "DO YOU WANT TO SAVE THE FORMAT":L$ = "FOR THIS REPORT TO DISK ": GOSUB 2510
  433. 15810  IF YES  THEN E = 1: GOSUB 19010
  434. 15815  POKE 216,0: PRINT : PRINT "MORE REPORTS USING THE "RN$(NN):L$ = "FORMAT ": GOSUB 2510
  435. 15820  IF YES  THEN E = 1:PAGE = 0:LC = 0: GOTO 15030
  436. 15825  GOTO 28010
  437. 16010  FOR I = 1 TO RH: ON  ABS(K(3 *I)) GOTO 16100,16030
  438. 16015  IF SEP = 1  AND J < >1  AND I = 1  THEN  IF  LEFT$(N$(Y,K(3 *I -2)),1) < > LEFT$(N$(R(J -1),K(3 *I -2)),1)  THEN  PRINT 
  439. 16020  POKE 36,K(3 *I -1): PRINT N$(Y,K(3 *I -2));: GOTO 16040
  440. 16030  POKE 36,K(3 *I -1) +L%(K(3 *I -2)) - LEN(N$(Y,K(3 *I -2))): PRINT N$(Y,K(3 *I -2));
  441. 16040  NEXT I
  442. 16050  IF K(0) < >1  OR HC = 0  THEN 16080
  443. 16060 DT = HC:T = 0: GOSUB 27510
  444. 16070  POKE 36,T: PRINT DT$;:GT = GT +HC:HC = 0
  445. 16080 LN = LN +1: PRINT : RETURN 
  446. 16100 N = 3 *I -2: IF  LEN(N$(Y,K(N))) = 0  THEN 16040
  447. 16110 DT =  VAL(N$(Y,K(N))):T = 0: GOSUB 27510:V =  VAL(DT$): POKE 36,T: PRINT DT$;:AC(I) = AC(I) +V:HC = HC +(V *K(3 *I)): GOTO 16040
  448. 17010  POKE 36,K(2): FOR I = K(2) TO WIDE -1: PRINT "-";: NEXT I: PRINT : RETURN 
  449. 17020  GOSUB 17010: FOR I = 1 TO RH: IF AC(I) = 0  THEN 17070
  450. 17050 DT = AC(I):T = 0: GOSUB 27510: POKE 36,T: PRINT DT$;
  451. 17070  NEXT I
  452. 17080  ON GT = 0 GOTO 17090:DT = GT:T = 0: GOSUB 27510: POKE 36,T: PRINT DT$;
  453. 17090  PRINT : RETURN 
  454. 18010  HOME : IF LN  AND  LEN(TD$) >0  THEN  PRINT  CHR$(12)
  455. 18012 LS = 0
  456. 18015 T = (WIDE +K(2))/2 - LEN(DB$) -8: IF T <1  THEN T = 1
  457. 18020 LN = 0: POKE 36,T: PRINT  CHR$(14) +FD$" DATA BASE":LN = LN +1
  458. 18030  POKE 36,K(2): PRINT RN$(NN)" REPORT FOR ";: IF Q$ = "ALL"  THEN  PRINT "ALL RECORDS":LN = LN +1: GOTO 18110
  459. 18040  PRINT H$(S)" ";: IF Q$ < >"@"  THEN  PRINT ": "Q$;
  460. 18050  IF K$ = "NO"  THEN  PRINT :LN = LN +1: GOTO 18110
  461. 18060  PRINT :LN = LN +1
  462. 18070  IF HR = 1  THEN  POKE 36,K(2): PRINT "OR ";
  463. 18080  IF HR = 2  THEN  POKE 36,K(2): PRINT "AND ";
  464. 18090  PRINT H$(K);: IF K$ < >"@"  THEN  PRINT ": "K$;
  465. 18100  PRINT :LN = LN +1
  466. 18110 PAGE = PAGE +1: POKE 36,T: PRINT TD$;
  467. 18115  IF   NOT PF  THEN  PRINT : GOTO 18130
  468. 18120  POKE 36,WIDE -5 - LEN( STR$(PAGE)): PRINT "PAGE "PAGE:LN = LN +1
  469. 18130  GOSUB 17010
  470. 18140  FOR I = 1 TO RH
  471. 18150  POKE 36,K(3 *I -1): PRINT H$(K(3 *I -2));
  472. 18160  NEXT I
  473. 18170  IF K(0) = 1  THEN  POKE 36,K(3 *I -1) +3: PRINT "TOTAL";
  474. 18180  PRINT : GOSUB 17010
  475. 18190 LN = LN +3: RETURN 
  476. 19000  REM  << WRITE FILES >>
  477. 19010 NS = NR
  478. 19020  PRINT 
  479. 19030 F$ = "RPTFMT" +RN$(NN)
  480. 19040 NR = 3 *RH +3
  481. 19050  FOR I = 1 TO NR:R$(I) =  STR$(K(I)): NEXT I
  482. 19060 R$(I -3) =  STR$(K(0))
  483. 19070 R$(I -1) =  STR$(FT)
  484. 19080  GOSUB 24010: GOSUB 25010
  485. 19090  RETURN 
  486. 20000  REM  << READ FILES >>
  487. 20010 F$ = "RPTFMT" +RN$(NN)
  488. 20020  GOSUB 23010
  489. 20030 RH = (NR -3)/3: FOR I = 1 TO NR:K(I) =  VAL(R$(I)): NEXT I
  490. 20040 K(0) =  VAL(R$(I -3)):K(I -3) = NH +1
  491. 20050 FT =  VAL(R$(I -1))
  492. 20060 NR = NS
  493. 20070  GOSUB 21010: PRINT : GOTO 15508
  494. 21000  REM  << SELECT FROM >>
  495. 21010  HOME : PRINT "SELECT FROM:": PRINT 
  496. 21020  IF MF = 0  THEN  PRINT "0 "H$(0)
  497. 21030  FOR I = 1 TO NH: PRINT I" "H$(I): NEXT I: PRINT 
  498. 21040 MF = 0
  499. 21050  RETURN 
  500. 22010 NN = 0: FOR I = 0 TO 21:RN$(I) = "": NEXT I:NS = NR
  501. 22020 F$ = "RPTFMTNAME"
  502. 22030  ONERR  GOTO 22160
  503. 22035  PRINT D$;"VERIFY";PX$ +FD$ +"/" +F$
  504. 22040  GOSUB 23010
  505. 22050  POKE 216,0
  506. 22060  FOR I = 1 TO NR:RN$(I) = R$(I): NEXT I
  507. 22070  HOME : PRINT "SELECT FROM:": PRINT 
  508. 22080  FOR I = 1 TO NR: PRINT I" "R$(I): NEXT I: PRINT 
  509. 22090  PRINT I" CREATE A NEW REPORT FORMAT"
  510. 22100  PRINT I +1" DELETE A REPORT FORMAT": PRINT I +2" RETURN TO THE MENU": PRINT 
  511. 22104  PRINT I +3" CHANGE PRINTER STATUS"
  512. 22106  PRINT "       CURRENT STATUS IS ";: IF PF  THEN  INVERSE : PRINT "ON": NORMAL : GOTO 22110
  513. 22108  INVERSE : PRINT "OFF": NORMAL : PRINT 
  514. 22110 L$ = "WHICH ":CHOICE = I +3: GOSUB 2410:S = R
  515. 22115  IF S = I +2  THEN NR = NS: GOTO 28010
  516. 22116  IF S = I +3  THEN  GOSUB 29110: GOTO 22070
  517. 22120 NN = S
  518. 22130  IF S <I  THEN RN$(S) = R$(S):E = 1:NR = NS: GOTO 20010
  519. 22140  IF S = I +1  THEN 30010
  520. 22150  GOTO 22200
  521. 22160  CALL 1013: HOME : PRINT "NO REPORT FORMATS ON DISK...": PRINT 
  522. 22170  POKE 216,0
  523. 22180 NN = 1
  524. 22190 L$ = "DO YOU WANT TO CREATE ONE": GOSUB 2510: IF   NOT YES  THEN NR = 0: GOTO 30100
  525. 22200  HOME : GOSUB 21020:NR = NS: GOTO 15100
  526. 23000  REM  << READ FILE >>
  527. 23010 FF = 0: IF F$ < >"INDEX"  THEN FF = 1
  528. 23015 Q$ = PX$ +FD$ +"/" +F$
  529. 23017  IF F$ = ""  THEN Q$ = PX$ +"BASENAMES"
  530. 23020  PRINT D$"OPEN";Q$
  531. 23030  PRINT D$"READ";Q$
  532. 23040  INPUT NR
  533. 23050  FOR J = 1 TO NR
  534. 23060  ON FF GOTO 23130
  535. 23070  FOR I = 1 TO NH
  536. 23080  CALL 768,N$(J,I)
  537. 23090 L =  LEN(N$(J,I)): IF L >L%(I)  THEN L%(I) = L
  538. 23100  NEXT I
  539. 23110 R(J) = J
  540. 23120  GOTO 23140
  541. 23130  CALL 768,R$(J)
  542. 23140  NEXT J
  543. 23150  PRINT D$"CLOSE"
  544. 23160 FF = 0
  545. 23170  RETURN 
  546. 24010 NR$ =  RIGHT$("00000" + STR$(NR),5)
  547. 24020 FF = 0: IF F$ < >"INDEX"  THEN FF = 1
  548. 24025  ONERR  GOTO 60010
  549. 24030 Q$ = PX$ +FD$ +"/" +F$
  550. 24032  IF F$ = ""  THEN Q$ = PX$ +"BASENAMES"
  551. 24035  PRINT D$"CLOSE"
  552. 24040  PRINT D$"OPEN"Q$: PRINT D$"WRITE"Q$
  553. 24050  PRINT NR$
  554. 24060  FOR J = 1 TO NR
  555. 24070  ON FF GOTO 24130
  556. 24080 Y = R(J)
  557. 24090  FOR I = 1 TO NH
  558. 24100  PRINT N$(Y,I)
  559. 24110  NEXT I
  560. 24120  GOTO 24140
  561. 24130  PRINT R$(J)
  562. 24140  NEXT J
  563. 24150  PRINT D$"CLOSE"
  564. 24160 FF = 0
  565. 24170  RETURN 
  566. 25010 NR = NN:I = 0
  567. 25020 F$ = "RPTFMTNAME"
  568. 25030 I = I +1: IF I <NR  AND RN$(NN) = RN$(I)  THEN NR = NR -1
  569. 25035 R$(I) = RN$(I): IF I <NR  THEN 25030
  570. 25040  GOSUB 24010
  571. 25050 NR = NS: RETURN 
  572. 26000  REM  << LIST RECORDS >>
  573. 26010 L = 0:LT = 60:AR = 0: HOME :X = 0: FOR I = 1 TO NH: IF  LEN(H$(I)) >X  THEN X =  LEN(H$(I))
  574. 26020  NEXT I: IF PF  THEN  GOSUB 2100: HOME : GOTO 26040
  575. 26025  VTAB 3: PRINT "HOW DO YOU WISH TO 'LIST ALL RECORDS'?": PRINT : PRINT  TAB( 8)"1. SCREEN AT A TIME."
  576. 26030  PRINT  TAB( 8)"2. SCROLL ALL RECORDS.": PRINT : PRINT 
  577. 26035 L$ = "               WHICH ":CHOICE = 2: GOSUB 2410:AR = R -1: HOME 
  578. 26040  IF (PF)  OR (AR)  THEN  PRINT "PRESS <RETURN> TO STOP/START...": PRINT "PRESS <ESC> TO ABORT...": POKE 34,3
  579. 26045  HOME : IF PF  THEN  GOSUB 2010
  580. 26050  FOR J = 1 TO NR:Y = R(J)
  581. 26060  GOSUB 11010
  582. 26065  IF (PF)  OR (AR)  THEN 26140
  583. 26070  IF AR = 0  AND L +NH >20  THEN 26130
  584. 26080  NEXT J
  585. 26085  IF PF  THEN  PRINT  CHR$(12): POKE 34,0: HOME 
  586. 26090  PRINT D$"PR#0"
  587. 26100  IF LF  THEN LF = 0: GOTO 28010
  588. 26110  INPUT "PRESS RETURN FOR MENU...";L$
  589. 26120  GOTO 28010
  590. 26130  IF J = NR  THEN 26080
  591. 26140  GOSUB 9010
  592. 26150  IF LF  THEN J = NR
  593. 26160  GOTO 26080
  594. 27010  HOME : PRINT "SELECT NUMERICAL FORMAT:": PRINT 
  595. 27020  PRINT "1. INTEGER           X"
  596. 27030  PRINT "2. 1 DECIMAL PLACE   X.X"
  597. 27040  PRINT "3. 2 DECIMAL PLACES  X.XX"
  598. 27050  PRINT :L$ = "WHICH ":CHOICE = 3: GOSUB 2410: PRINT 
  599. 27060 FT = R: RETURN 
  600. 27510  IF   NOT FT  THEN 27620
  601. 27520  ON FT GOTO 27530,27540,27550
  602. 27530 DT =  SGN(DT) * INT( ABS(DT) +.5): GOTO 27560
  603. 27540 DT =  SGN(DT) * INT( ABS(DT) *10 +.5)/10:T = T -2: GOTO 27560
  604. 27550 DT =  SGN(DT) * INT( ABS(DT) *100 +.5)/100:T = T -3
  605. 27560 P1 =  INT( ABS(DT)): IF DT <0  THEN T = T -1
  606. 27570 P2 =  INT(( ABS(DT) -P1) *100 +.5):DT$ = ""
  607. 27580  FOR L = 1 TO L%(K(3 *I -2)) -1:T = T +(P1 < INT(10 ^L)): NEXT 
  608. 27590 DT$ =  STR$( ABS(DT)): IF P1 = 0  THEN DT$ = "0" +DT$
  609. 27595  IF DT <0  THEN DT$ = "-" +DT$
  610. 27597  ON FT = 1 GOTO 27620
  611. 27600  IF P2 = 0  THEN DT$ = DT$ +".0": IF FT = 3  THEN DT$ = DT$ +"0": GOTO 27620
  612. 27610  IF FT = 3  AND ( INT(P2/10) = P2/10)  THEN DT$ = DT$ +"0"
  613. 27620 T = K(3 *I -1) +T: RETURN 
  614. 28000  REM  << MAIN MENU >>
  615. 28010  TEXT : GOTO 28110
  616. 28100  CALL 1013
  617. 28110  HOME 
  618. 28120  IF PF  THEN PF = 1
  619. 28140  PRINT "   *****  FILE CABINET - PRODOS *****"
  620. 28150  PRINT 
  621. 28160  PRINT "CURRENT DATA BASE:": PRINT  TAB( 16 -( LEN(FD$)/2))">>> "FD$" <<<"
  622. 28170  PRINT : PRINT "CURRENTLY CONTAINS: "NR" RECORDS": PRINT "ROOM FOR "B -NR" MORE RECORDS"
  623. 28180  PRINT 
  624. 28190  PRINT "THE PRINTER IS ";: IF   NOT PF GOTO 28200
  625. 28195  FLASH : PRINT "ON": NORMAL : GOTO 28210
  626. 28200  PRINT "OFF"
  627. 28210  PRINT 
  628. 28220  PRINT "1. SELECT DIFFERENT DATA BASE"
  629. 28230  PRINT "2. ENTER RECORDS"
  630. 28240  PRINT "3. SEARCH AND/OR CHANGE DATA"
  631. 28250  PRINT "4. DELETE RECORDS"
  632. 28260  PRINT "5. REPORT"
  633. 28270  PRINT "6. SORT >"FD$"< DATA BASE"
  634. 28280  PRINT "7. LIST ALL RECORDS"
  635. 28290  PRINT "8. TURN PRINTER ";: IF PF  THEN  PRINT "OFF": GOTO 28310
  636. 28300  PRINT "ON"
  637. 28310  PRINT "9. QUIT"
  638. 28320  PRINT 
  639. 28330  POKE 216,0: PRINT "WHICH ->  ?"
  640. 28340  VTAB 21: HTAB 11: INPUT "";MS$:MS =  VAL(MS$)
  641. 28500  IF MS <1  OR MS >9  THEN  VTAB 21: HTAB 11: CALL  -958: PRINT "?": GOTO 28340
  642. 28510  CALL  -958: IF NR  THEN 28540
  643. 28520  IF MS <3  OR MS >7  THEN 28540
  644. 28530  PRINT : PRINT "THERE ARE NO RECORDS ON FILE":MS = 0
  645. 28535  FOR Z = 1 TO 1500: NEXT Z: GOTO 28500
  646. 28540  ON MS GOTO 3050,7010,8010,12010,15010,5400,26010,29010,31005
  647. 29000  REM  << PRINTER FLAG >>
  648. 29010  IF PF  THEN PF = 0:LN = 0: GOTO 29030
  649. 29020 PF = 1
  650. 29030  IF MS = 0  THEN  HOME : RETURN 
  651. 29035  VTAB 9: HTAB 16: CALL  -868: IF   NOT PF GOTO 29040
  652. 29038  FLASH : PRINT "ON": NORMAL : GOTO 29050
  653. 29040  PRINT "OFF"
  654. 29050  VTAB 18: HTAB 17: CALL  -868: IF PF  THEN  PRINT "OFF": GOTO 29070
  655. 29060  PRINT "ON"
  656. 29070 MS = 0: GOTO 28500
  657. 29100  REM  << SET PRINTER MODE >>
  658. 29110  IF PF  THEN PF = 0:LN = 0: GOTO 29130
  659. 29120 PF = 1
  660. 29130  RETURN 
  661. 30000  REM  << DELETE FILE >>
  662. 30010  HOME : PRINT "SELECT FROM:": PRINT 
  663. 30020  FOR I = 1 TO NR: PRINT I" "R$(I): NEXT I: PRINT 
  664. 30030 L$ = "DELETE WHICH NUMBER ":CHOICE = I -1: GOSUB 2410:S = R
  665. 30040  HOME : VTAB 10: PRINT "YOU HAVE SELECTED THE OPTION TO DELETE": INVERSE : PRINT RN$(S)" FORMAT": NORMAL 
  666. 30050 L$ = "IS THIS CORRECT": GOSUB 2510: IF   NOT YES  THEN NR = NS: GOTO 28010
  667. 30060 F$ = "RPTFMT" +RN$(S)
  668. 30065 Q$ = PX$ +FD$ +"/" +F$
  669. 30070  PRINT D$"DELETE";Q$
  670. 30075  PRINT D$"CLOSE"
  671. 30080  IF S = NR  THEN 30100
  672. 30090  FOR I = S TO NR -1:RN$(I) = RN$(I +1): NEXT I
  673. 30100 NR = NR -1:F$ = "RPTFMTNAME": IF NR <1  THEN 30130
  674. 30110 I = 0: GOSUB 25030
  675. 30120  GOTO 22010
  676. 30130 Q$ = PX$ +FD$ +"/" +F$
  677. 30132  PRINT D$"CLOSE"
  678. 30135  PRINT D$;"DELETE";Q$
  679. 30140 NR = NS: GOTO 28010
  680. 31000  REM  << QUIT ROUTINE >>
  681. 31005  IF NR = 0  AND FD$ < >"" GOTO 38010: REM  PREVENT FILES WITH ZERO RECORDS
  682. 31010  TEXT : HOME : VTAB 10
  683. 31020  HTAB 3: PRINT "A BACKUP COPY IS RECOMMENDED AFTER      EACH CHANGE SESSION!"
  684. 31030  VTAB 15: HTAB 3
  685. 31040  PRINT "TO ACTIVATE THE PRODOS 'FILER' PROGRAM  WHICH MUST HAVE BEEN TRANSFERRED TO     THIS DISK, ANSWER 'Y' TO THE REQUEST    FOR BACKUP.": PRINT : VTAB 20
  686. 31050 L$ = "BACKUP": GOSUB 2510
  687. 31060  IF   NOT YES  THEN  TEXT : HOME : END 
  688. 31070  ONERR  GOTO 31110
  689. 31080  PRINT D$;"VERIFY";PX$;"FILER"
  690. 31090  PRINT D$"-";PX +"FILER/"
  691. 31100  END 
  692. 31110  TEXT : HOME : VTAB 10
  693. 31120  PRINT "THE PRODOS 'FILER' WAS NOT FOUND ON     PATH ";PX$;"FILER"
  694. 31130  PRINT : PRINT "IF A BACKUP COPY IS DESIRED, TAKE       CORRECTIVE ACTION AND INITIATE THE COPY PROCESS FROM 'FILER'"
  695. 31160  POKE 216,0
  696. 31170  END 
  697. 32000  REM  << SETUP POKES >>
  698. 32010  FOR I = 1013 TO 1022: READ S: POKE I,S: NEXT I
  699. 32020 I = 0
  700. 32030  RETURN 
  701. 32040  DATA 104,168,104,166,223,154,72,152,72,96
  702. 33040  REM 
  703. 33075  GOSUB 60110: REM  SETUP DATE AFTER CLEAR
  704. 34000  FOR I = 1 TO 71: READ I%: POKE 768 +I -1,I%: NEXT I: RESTORE : RETURN 
  705. 34010  DATA  32,190,222,32,227,223,36,17,208,5,162,0,76,15,3,133,133,132,134,165
  706. 34020  DATA  184,164,185,133,135,132,136,32,44,213,173,0,2,201,3,208,3,76,99,216
  707. 34030  DATA  169,0,133,13,133,14,169,0,160,2,32,237,227,32,61,231,32,123,218,165
  708. 34040  DATA  135,164,136,133,184,132,185,32,183,0,96,0,0,0,0,0,0,0,0,0
  709. 38000  REM  << ZERO RECORDS >>
  710. 38010  HOME : VTAB 10
  711. 38020  PRINT "---- WARNING ----": PRINT 
  712. 38030  PRINT "CREATION OF FILES WITH ZERO RECORDS     RESULTS IN ERROR CONDITIONS LATER WHEN  RE-STARTING OR DELETING."
  713. 38040  PRINT 
  714. 38050  PRINT "CREATE AT LEAST ONE RECORD WITH DATA    TO PREVENT FUTURE PROBLEMS": PRINT 
  715. 38060  PRINT "PRESS ANY KEY TO RETURN TO THE MAIN MENU"
  716. 38070  GET K$
  717. 38080  GOTO 28010
  718. 60000  REM  << ERROR TRAP FOR INVALID INPUT >>
  719. 60010  TEXT : HOME : VTAB 10
  720. 60020  PRINT "  INVALID INPUT": PRINT 
  721. 60030  PRINT "PRODOS REQUIRES THAT FILE NAMES BEGIN   WITH A LETTER AND CONTAIN ONLY LETTERS, NUMBERS OR PERIODS."
  722. 60040  PRINT : PRINT "NO SPACES ARE PERMITTED,NAMES MUST NOT  EXCEED 15 CHARACTERS IN LENGTH -        INCLUDING ANY ASSIGNED BY THE PROGRAM."
  723. 60050  PRINT "SIX CHARACTERS ARE ADDED BY THE PROGRAM WHEN SAVING REPORT NAMES."
  724. 60060  PRINT : PRINT " PRESS ANY KEY TO RETURN TO REPORT MENU ";: GET K$
  725. 60070  POKE 216,0: GOTO 22010
  726. 60100  REM  << READ PRODOS DATE >>
  727. 60110 MD$ = "???JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC"
  728. 60120 DD =  PEEK(49040) - INT( PEEK(49040)/32) *32
  729. 60130 YY =  INT( PEEK(49041)/2)
  730. 60140 MM = ( PEEK(49041) -YY *2) *8 + INT( PEEK(49040)/32)
  731. 60150 MM$ =  MID$ (MD$,MM *3 +1,3)
  732. 60160 TD$ = MM$ +" " + STR$(DD) +", 19" + STR$(YY)
  733. 60170  RETURN 
  734. 60180 ::::
  735. 61000  REM  *********************
  736. 61010  REM        FILE CABINET
  737. 61020  REM           PRODOS
  738. 61030  REM  ---------------------
  739. 61040  REM      CONVERTED BY
  740. 61050  REM      MICHAEL MOORE
  741. 61060  REM         JUNE 1984
  742. 61070  REM  =====================
  743. 61080  REM         BASED ON
  744. 61090  REM   FILE CABINET-MACH 5
  745. 61100  REM      BY ED AYMOND  
  746. 61110  REM    AND BOB MATZINGER
  747. 61120  REM    AS A MODIFICATION
  748. 61130  REM   OF EARLIER VERSIONS
  749. 61140  REM  *********************
  750. 61150  REM  APPLE CORPS OF DALLAS